home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
bargraph.zip
/
BARGRAPH.PRG
< prev
Wrap
Text File
|
1993-04-12
|
7KB
|
169 lines
program Bargraph; {Draw bar graphs}
uses crt, graph;
const
ArraySize = 50; {Mod. #1}
TextSize = ArraySize;
MaxNumAxisAnn = ArraySize;
type
LineSize = string[80];
ArrayType = array[1..ArraySize] of real;
TextArrayType = array[1..TextSize] of LineSize;
AnnArrayType = array[0..ArraySize] of LineSize;
var
NumArray : ArrayType;
TempTextArr : TextArrayType;
XTextArr, YTextArr : AnnArrayType;
XOrigin, YOrigin, XAxisL, YAxisL, NumTicks : integer;
SubTicksX, SubTicksY, Count, Code, TextCount : integer;
LoYAxis, HiYAxis, NumSegsX, NumSegsY : integer;
UpLeftX, UpLeftY, LoRightX, LoRightY, J : integer;
ShadingType, ShadingColor, FlipFlop : integer;
GraphDriver, GraphMode, ErrorCode : integer;
DriverPath : string;
Unused, LowestY, HighestY, WidthX, ScaleY : real;
Depth : word;
CharFlag, Reply, Reply2 : char;
RealFormatY, MidX, MidY, Top : boolean;
{$I AnnXAxis.PSL}
{$I AnnYAxis.PSL}
{$I AxisText.PSL}
{$I DoXAxis.PSL}
{$I DoYAxis.PSL}
{$I GetNumI.PSL}
{$I GetReply.PSL}
{$I KeyHit.PSL}
{$I LoadArr.PSL}
{$I LoadTxt.PSL}
{$I Stats.PSL}
BEGIN
clrscr;
writeln('BarChart - Create bar charts');
XOrigin := 100; {Mod. #2}
YOrigin := 148; {Mod. #2}
XAxisL := 480; {Mod. #3}
YAxisL := 120; {Mod. #3}
RealFormatY := false; {Mod. #4}
MidX := true;
MidY := false;
SubTicksX := 0; {Mod. #5}
SubTicksY := 1; {Mod. #5}
LoYAxis := 0; {Mod. #6}
Depth := 0; {Mod. #7}
Top := topon; {Mod. #7}
GraphDriver := cga; {Mod. #8}
GraphMode := cgahi; {Mod. #8}
DriverPath := '\TP'; {Mod. #9}
Count := 0;
writeln;
writeln('The input data must be on a disk file.');
LoadArr(NumArray, Count, Code);
if (Code <> 0) or (Count < 1) then
begin
writeln('Error in reading data - program aborted.');
halt
end;
NumSegsX := Count;
Stats(NumArray, Count, Unused, Unused, Unused,
LowestY, HighestY);
writeln;
writeln('Y value at bottom of axis is set to ', LoYAxis:1);
if LowestY < LoYAxis then
writeln('Warning - some data is less than ', LoYAxis:1);
writeln;
writeln('Largest value in data file = ', HighestY:12);
repeat
writeln;
writeln('Y value at top of axis? (integer please)');
GetNumI(HiYAxis, CharFlag, Code) {Mod. #4}
until
(Code = 0) and (HiYAxis > LoYAxis) and
(HiYAxis >= HighestY);
repeat
writeln;
writeln('Number of primary tick marks on y-axis?');
GetNumI(NumTicks, CharFlag, Code)
until
(Code = 0) and (NumTicks >= 0);
if NumTicks < 2 then
NumSegsY := 0
else
NumSegsY := NumTicks - 1;
AxisText(YTextArr, NumSegsY, LoYAxis, HiYAxis, RealFormatY);
writeln;
writeln('Label for y-axis?');
write('? ');
readln(YTextArr[0]);
writeln;
writeln('If you want annotations for the x-axis tick marks,');
writeln('the annotations must be retrieved from a disk');
writeln('file. Provide the filespec of that file now, or');
writeln('press [Enter] to skip labeling of the tick marks.');
writeln;
TextCount := 0;
LoadTxt(TempTextArr, TextCount, Code);
for J := 1 to Count do
XTextArr[J] := '';
for J := 1 to TextCount do
XTextArr[J] := TempTextArr[J];
writeln;
writeln('Label for x-axis?');
write('? ');
readln(XTextArr[0]);
writeln;
writeln('Shading style options'); {Mod. #10}
writeln(' 0 - No shading 3 - Crosshatch'); {Mod. #10}
writeln(' 1 - Solid fill 4 - Dot fill'); {Mod. #10}
writeln(' 2 - Diagonal 5 - Herringbone'); {Mod. #10}
GetReply('0', '5', Reply); {Mod. #10}
writeln(Reply); {Mod. #10}
case Reply of {Mod. #10}
'0': ShadingType := 0; {Mod. #10}
'1': ShadingType := 1; {Mod. #10}
'2': ShadingType := 3; {Mod. #10}
'3': ShadingType := 8; {Mod. #10}
'4': ShadingType := 11; {Mod. #10}
'5': ShadingType := 5 {Mod. #10}
end; {Mod. #10}
FlipFlop := 0; {Mod. #10,11}
if ShadingType = 5 then {Mod. #10,11}
FlipFlop := 1; {Mod. #10,11}
writeln;
writeln('Press a key to see the bar chart. When finished,');
writeln('press a key to clear the screen.');
repeat until KeyHit(Reply, Reply2);
initgraph(GraphDriver, GraphMode, DriverPath);
ErrorCode := graphresult;
if ErrorCode <> 0 then
begin
write(chr(7));
writeln('Graph initialization error - program aborted');
halt
end;
DoXAxis(XOrigin, YOrigin, XAxisL, NumSegsX, SubTicksX);
DoYAxis(XOrigin, YOrigin, YAxisL, NumSegsY, SubTicksY);
AnnXAxis(XOrigin, YOrigin, XAxisL, NumSegsX, XTextArr, MidX);
AnnYAxis(XOrigin, YOrigin, YAxisL, NumSegsY, YTextArr, MidY);
ScaleY := YAxisL / (HiYAxis - LoYAxis);
WidthX := XAxisL / Count;
LoRightY := YOrigin;
ShadingColor := getmaxcolor; {Mod. #12}
for J := 1 to Count do
begin
UpLeftX := XOrigin + trunc(WidthX * (J - 1));
UpLeftY := round(YOrigin - (NumArray[J] - LoYAxis) *
ScaleY);
LoRightX := XOrigin + trunc(WidthX * J);
FlipFlop := - FlipFlop;
ShadingType := ShadingType + FlipFlop; {Mod. #10}
setfillstyle(ShadingType, ShadingColor);
bar3d(UpLeftX, UpLeftY, LoRightX, LoRightY, Depth, Top)
end;
repeat until KeyHit(Reply, Reply2);
textmode(bw80)
END.